home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / Z-Misc Series / (k)zk.d64 / pl0.test1 < prev    next >
Text File  |  2007-03-01  |  1KB  |  56 lines
  1. 0010 // CONST M=7, N=85;
  2. 0020 // VAR X, Y, Z, Q, R;
  3. 0030 //
  4. 0040 // PROCEDURE MULT;
  5. 0050 //  VAR A, B;
  6. 0060 //  BEGIN
  7. 0070 //   A:=X; B:=Y; Z:=0;
  8. 0080 //   WHILE B>0 DO
  9. 0090 //   BEGIN
  10. 0100 //    IF ODD B THEN Z:=Z+A;
  11. 0110 //    A:=2*A; B:=B/2;
  12. 0120 //   END;
  13. 0130 //  END;
  14. 0140 //
  15. 0150 // PROCEDURE DIVID;
  16. 0160 //  VAR W;
  17. 0170 //  BEGIN
  18. 0180 //   R:=X; Q:=0; W:=Y;
  19. 0190 //   WHILE W<=R DO W:=2*W;
  20. 0200 //   WHILE W>Y DO
  21. 0210 //   BEGIN
  22. 0220 //    Q:=2*Q; W:=W/2;
  23. 0230 //    IF W<=R THEN
  24. 0240 //    BEGIN
  25. 0250 //     R:=R-W; Q:=Q+1;
  26. 0260 //    END;
  27. 0270 //   END;
  28. 0280 // END;
  29. 0290 //
  30. 0300 // PROCEDURE GCD;
  31. 0310 //  VAR F, G;
  32. 0320 //  PROCEDURE EXCHANGE;
  33. 0330 //   VAR H;
  34. 0340 //   BEGIN
  35. 0350 //    H:=F; F:=G; G:=H;
  36. 0360 //   END;
  37. 0370 //  BEGIN
  38. 0380 //   F:=X; G:=Y;
  39. 0390 //   WHILE F<>0 DO
  40. 0400 //   BEGIN
  41. 0410 //    IF F<G THEN G:=G-G/F*F;
  42. 0420 //    IF G<F THEN CALL EXCHANGE;
  43. 0430 //   END;
  44. 0440 //   Z:=G;
  45. 0450 //  END;
  46. 0460 //
  47. 0470 // BEGIN
  48. 0480 //  X:=M; Y:=N;
  49. 0490 //  CALL MULT; WRITE(Z); WRITELN;
  50. 0500 //  X:=25; Y:=3;
  51. 0510 //  CALL DIVID;
  52. 0520 //  WRITE(Q); WRITE(R); WRITELN;
  53. 0530 //  X:=84; Y:=36;
  54. 0540 //  CALL GCD; WRITE(Z); WRITELN;
  55. 0550 // END.
  56.